﻿' ------------------------------------------------------------------------------
' Various utility methods for
'
'   - password crypto
'   - wrappers around win32 functions GetLastError, GetLastErrorMessage
'   - temp file names that are automatically cleaned up using
'     System.CodeDom.Compiler.TempFileCollection
'   - capitalizing strings
'
' Since the application stores connection information in the application's
' settings file, any connection password would be stored as plaintext in plain
' sight unless it was encrypted. The crypto methods deal with this using DES.
' This is a locked barn door approach, since encryption key and initialization
' vector in this file could possibly become compromised.
' ------------------------------------------------------------------------------
' This file is part of the SQL Server 2008 Technology Demonstration. This
' application was designed and coded by Eric Weitzman, LandTime Inc, for
' Microsoft Corporation. Contact Ed Katibah at Microsoft about this demo.
' Copyright © 2008 Microsoft Corporation. All rights reserved.
' ------------------------------------------------------------------------------

Imports System.Security.Cryptography
Imports System.Runtime.InteropServices

Public Module MiscellaneousUtils

    Private Const HDR1 As String = "--"
    Private Const HDR2 As String = "enc64:"

    Private m_crypto As DES = Nothing
    Private m_key As Byte() = Nothing
    Private m_iv As Byte() = Nothing

    Private Const c_company As String = "LandTime"
    Private Const c_author As String = "weitzman"

    Private Const FORMAT_MESSAGE_FROM_SYSTEM As Integer = &H1000
    Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Integer = &H200

    <DllImport("kernel32.dll", SetLastError:=True)> _
    Public Function GetLastError() As UInt32
    End Function

    <DllImport("kernel32.dll", SetLastError:=True, entrypoint:="FormatMessageA")> _
    Public Function FormatMessage(ByVal dwFlags As UInt32, _
                                  ByVal lpSource As IntPtr, _
                                  ByVal dwMessageId As UInt32, _
                                  ByVal dwLanguageId As UInt32, _
                                  ByVal lpBuffer As System.Text.StringBuilder, _
                                  ByVal nSize As UInt32, _
                                  ByVal Arguments As IntPtr) As UInt32
    End Function

    Public Function GetLastErrorMessage(ByVal ErrorCode As UInt32) As String
        Dim msg As New System.Text.StringBuilder(1024)
        Dim len As UInt32 = 256
        FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, IntPtr.Zero, ErrorCode, 0, msg, len, IntPtr.Zero)
        Return msg.ToString
    End Function

    ' TempFileCollection creates one unique filename base to which it appends an extension and
    ' then returns a path via AddExtension(). We use filenames such as <randombase>.1.html,
    ' <randombase>.2.html, and so on to ensure "extension" uniqueness and avoid overriding
    ' files with the same extension.

    Public Function TempFileName(ByVal ext As String) As String

        Static tempcoll As New System.CodeDom.Compiler.TempFileCollection()
        Static seq As Integer = 0

        seq += 1
        ext = seq.ToString & "." & ext.Trim("."c).Trim()
        Dim tmp As String = tempcoll.AddExtension(ext)

        'ReportTrace("temp file: " & tmp)
        Return tmp

    End Function


    ' Capitalize individual words in a string, taking care of single quotes
    ' in proper names and the possessive apostrophe. This method was required
    ' to convert the placenames in the City spatial data from all upper-case
    ' to normal capitalization.

    Public Function Capitalize(ByVal s As String) As String
        Dim nextcaps As Boolean = True
        Dim a() As Char = s.Trim.ToCharArray

        For i As Integer = 0 To a.Length - 1

            If Not Char.IsLetter(a(i)) Then
                If a(i) = "'"c Then
                    Dim rest As String = s.Substring(i).ToLower
                    If rest.ToLower = "'s" Then ' at end of line
                        nextcaps = False
                    ElseIf rest.Length > 2 AndAlso rest.Substring(0, 3) = "'s " Then ' at end of word followed by a space
                        nextcaps = False
                    Else ' something like O'Smiley or O'Donnell
                        nextcaps = True
                    End If
                Else
                    nextcaps = True
                End If

            Else
                If nextcaps Then
                    a(i) = Char.ToUpper(a(i))
                Else
                    a(i) = Char.ToLower(a(i))
                End If
                nextcaps = False
            End If
        Next
        Return New String(a)
    End Function

    Public Function DecryptPassword(ByVal password As String) As String
        Dim cleartext As String
        If password.StartsWith(HDR1) Then
            cleartext = password.Substring(HDR1.Length)
        ElseIf password.StartsWith(HDR2) Then
            cleartext = DecryptString(password.Substring(HDR2.Length))
        Else
            cleartext = password
        End If
        'ReportTrace(String.Format("input password: '{0}'", password))
        'ReportTrace(String.Format("decrypted password '{0}'", cleartext))
        Return cleartext
    End Function

    Public Function EncryptPassword(ByVal password As String) As String
        Dim ciphertext As String
        If password.Length < HDR1.Length Then
            ciphertext = HDR2 & EncryptString(password)
        ElseIf password.StartsWith(HDR1) Then
            ciphertext = password ' already encrypted
        Else
            ciphertext = HDR2 & EncryptString(password)
        End If
        'ReportTrace(String.Format("input password: '{0}'", password))
        'ReportTrace(String.Format("encrypted password '{0}'", ciphertext))
        Return ciphertext
    End Function

    Private Function EncryptString(ByVal cleartext As String) As String ' returns base64-encoded string
        CheckCrypto()
        Dim clearbytes() As Byte = (New System.Text.UnicodeEncoding).GetBytes(cleartext)
        Dim enc As ICryptoTransform = m_crypto.CreateEncryptor(m_key, m_iv)
        Dim cipherbytes() As Byte = enc.TransformFinalBlock(clearbytes, 0, clearbytes.Length)
        Dim ciphertext64 As String = System.Convert.ToBase64String(cipherbytes, Base64FormattingOptions.None)
        Return ciphertext64

        'ReportTrace("key: " & System.Convert.ToBase64String(key, Base64FormattingOptions.None))
        'ReportTrace("iv:  " & System.Convert.ToBase64String(iv, Base64FormattingOptions.None))
        'Dim dec As ICryptoTransform = crypto.CreateDecryptor(key, iv)
        'Dim clearbytes2() As Byte = dec.TransformFinalBlock(cipherbytes, 0, cipherbytes.Length)
        'Dim cleartext2 As String = (New System.Text.UnicodeEncoding).GetString(clearbytes)
        'Return DecryptString(ciphertext64)

    End Function

    Private Function DecryptString(ByVal ciphertext64 As String) As String
        CheckCrypto()
        Dim cipherbytes() As Byte = System.Convert.FromBase64String(ciphertext64)
        Dim dec As ICryptoTransform = m_crypto.CreateDecryptor(m_key, m_iv)
        Dim clearbytes() As Byte = dec.TransformFinalBlock(cipherbytes, 0, cipherbytes.Length)
        Dim cleartext As String = (New System.Text.UnicodeEncoding).GetString(clearbytes)
        Return cleartext
    End Function

    Private Sub CheckCrypto()
        If m_crypto Is Nothing Then
            m_crypto = DES.Create
            m_key = (New System.Text.ASCIIEncoding).GetBytes(c_company)
            m_iv = (New System.Text.ASCIIEncoding).GetBytes(c_author)
        End If
    End Sub

End Module
